00200		TITLE	SOUND;  DOROTHY BENDER ****** 1969, 1975(LCS)*******
00400	
00600	;  ROUTINE TO READ THE OUTPUT FROM THE MUSIC
00800	;  PROGRAM AND CALL THE D-A CONVERTER TO PLAY.
01000	;  
01200	;  NAME OF THE FILE TO BE INPUTTED IS 'MUSIC.MUS' OR 'MUSAA.DMD',
01400	;  THE FIRST RECORD OF WHICH CONTAINS THE
01600	;  NUMBER OF WORDS OF DATA IN THE ENTIRE DISK FILE.
01800	
02000	A   ←   1     ;WORK
02200	B   ←   2     ;WORK
02400	RET ←   3     ;RETURN ACCUMULATOR
02600	;;BUFSIZ ←=20224   ;****** DOUBLE THIS FOR 4-CHANNEL SOUND!!!!!	
02800	BUFSIZ ←4400*10	;BIGPLAY -----(←4400*3 IN SYS VERSION)
03000	↓DSKCHN ←1             ;DISK CHANNEL FOR INPUT
03200	↓ADCHN  ←2             ;D-A CHANNEL FOR OUTPUT
03400	
03600		OPDEF	READCH [51B8]
03800	        OPDEF   MESSAGE[51B8!3B12]
04000	
04200	BEG:	CALLI	0,0         ;RESET I/O DEVICES
04400	 	OPEN 	DSKCHN,[17  ;MODE
04600			'DSK   '    ;DEVICE NAME
04800	 		0]          ;NO BUFFER HEADERS
05000		HALT	BEG         ;RESTART IF DEVICE IS UNAVAILABLE
05200	
05400		MOVE 6,['MUSAA ']
05600		MOVE 7,['DMD   ']
05800	 	SETZM	DIR2+3    ;FOR RESTART
06000	 	SETZM	DIR+3    ;FOR RESTART
06200		OUTSTR[ASCIZ/FILE NAME -- /]  ;READS '.DMD' FILES ONLY.
06400		SETZM DIR+1
06600		SETZM DIR
06800		SETO 5,		;FLAG FOR EXTENSIONS
07000		MOVE  2,[POINT 6,DIR]
07200		JRST GOT
07400	EXT:	MOVE 2,[POINT 6,DIR+1]
07600		SETZ 5,
07800	GOT:	INCHWL	1
08000		CAIN  1,15	; A CR?
08200		JRST  GOT
08400		CAIGE	1,60		; CHECKS FOR GOOD CHARS.
08600		JRST	LX  
08800		SUBI	1,40
09000		IDPB	1,2
09200		JRST	GOT
09400	LX:	JUMPE 5,LZ
09600		SKIPN DIR
09800		MOVEM 6,DIR
10000		CAIN  1,56 	; 56='.'
10200		JRST EXT
10400		JRST MESS
10600	LZ:	SKIPN DIR+1
10800		MOVEM 7,DIR+1
13000		;FIND OUT NUMBER OF CHANNELS AND THE SPEED.
13400	MESS:	MESSAGE	[ASCIZ/  HOW MANY CHANNELS? /]
13600		READCH	A
13800		SUBI	A,"0"+1		;CONVERT TO BINR AND ADD 1
14000		DPB	A,[POINT 2,OUTBIT,26]
14200	
14400	SPD:	MESSAGE [ASCIZ/  SPEED? /]
14600		READCH  A
14800		CAIG A,65		;IS IT 1 - 5?
15000		JRST SPD2		;YES
15200		SKIPN DIR+3		;IS THIS THE 1ST TIME THRU?
15400		JRST SPD		;YES, SO WE NEED A GOOD NUM.
15600		JRST PLA2 		;ANYTHING ELSE WILL REPLAY
15800	SPD2:	SUBI	A,"0"
16000		DPB	A,[POINT 3,OUTBIT,32]
16200	
16400	PLA2:	SETZM DIR+3
16500		SETZM DIR2+3
16510		MOVE 5,DMD		;GET 'DMD   '
16600		LOOKUP	DSKCHN,DIR   
16700		SKIPA			;CAN'T FIND MUSAA.DMD
16800		JRST XOPEN		;FOUND IT
16860		CAMN 5,DIR+1		;IS DIR+1='DMD   '?
16870		JRST MUS		;YES, GO LOOK FOR MUSIC.MUS
16880		MOVEM 5,DIR+1
16890		JRST PLA2		;TRY IT WITH 'DMD   '
16900	MUS:	LOOKUP  DSKCHN,DIR2	;TRY FOR MUSIC.MUS
17000	
17100		JRST	[MESSAGE[ASCIZ/
17200			*** MUSIC FILE NOT FOUND/]
17300			CALLI  12]
17400	        ;EXIT IF FILE IS MISSING
17500		MOVE A,DIR2+3	;GET LENGTH OF MUSIC.MUS
17600		MOVEM A,DIR+3;PUT IT IN RIGHT PLACE
19000	
21000	XOPEN:	OPEN	ADCHN,[117 	;MODE
21200	         	'AD    '        ;DEVICE NAME
21400	 		0]              ;NO BUFFER HEADERS
21600	
21800	  	JRST	[MESSAGE[ASCIZ/
22000			***D-A NOT AVAILABLE/]
22200			CALLI  12]
22400		;EXIT IF D-A IS UNAVAILABLE
22600	
22610	XGPOK:	MOVSI	'XGP'	;DOWN TO SPWAR FOR XGP CONFLICT.
22631		DEVUSE	0,	
22652		HLRZ 	0,0
22673		CAIN	400000
22694		JRST	SPWAR
22715		INIT	16,17
22736		SIXBIT	.XGP.
22757		0
22778		JRA	16,2(16)
22800	SPWAR:	LOCK A,
23000	;;	SPCWAR 17,[CALLI]
23200		MESSAGE [ASCIZ/ GO? /]
23400		READCH A
23600	
23800	
24000	LNTH:	movs a,DIR+3		;get length of file.
24200		movnm a,nwd
24400	;-----------------------------------------------------
24600	
24800		;BEGIN MAIN BODY OF PROGRAM
25000	
25200	LOOP:	JSP	RET,SUB		;ROUTINE TO READ AND WRITE
25400		BUF1-1 			;USE BUF1 FOR THE I/O
25600		JUMPLE	B,OUT    	;DONE
25800		
26000		JSP	RET,SUB		;CALL IT AGAIN
26200		BUF2-1			;USE BUF2 FOR THE I/O
26400		JUMPG	B,LOOP		;GO BACK FOR MORE IF B>0
26600	
26800	OUT:	close dskchn,		;END OF PROGRAM.
27000		releas adchn,
27200	;;	SPCWAR 0,'SSW'
27400		UNLOCK
27600		RELEASE 16,
27800		jrst SPD
28000	
28200		;SUBROUTINE TO SET UP IOWD AND READ AND WRITE.
28400		;  1(RET) WILL BE THE RETURN
28600		;  0(RET) WILL BE THE ADDRESS OF THE BUFFER TO BE
28800		;         PUT IN THE RIGHT HALF OF THE IOWD.
29000		;  A      WILL BE A WORK REGISTER
29200	    	;  B      WILL BE TESTED ON THE OUTSIDE.
29400	
29600	SUB:	MOVNI	A,BUFSIZ	;PICK UP AND COMPLEMENT BUFSIZ
29800		ADDB	A,NWD		;A←NWD-BUFSIZ
30000					;NWD←NWD-BUFSIZ
30200		MOVE	B,A		;SAVE B TO BE TESTED FOR LAST
30400					;TIME.
30600		JUMPL	A,LAST		;SET UP FOR LAST TIME.
30800		MOVEI	A,0		
31000	
31200		;THE IOWD LOOKS LIKE:
31400		;  [-BUFSIZ / BUFI-1]
31600	
31800	LAST:	ADDI	A,BUFSIZ
32000		MOVNS	A		;COMPLEMENT A
32200		HRL	A,0(RET)	;PICK UP BUFI AND MOVE IT
32400					;TO THE LEFT SIDE OF A.
32600		MOVSM	A,INLIST	;SWAP A AND MOVE IT.
32800		MOVSM	A,OUTWC		;SAME FOR OUTPUT.
33000		INPUT	DSKCHN,INLIST	;READ A RECORD.
33200		OUTPUT	ADCHN,OUTWC	;WRITE THE RECORD.
33400		JRST	1(RET)		;RETURN
33600	;---------------------------------------------------------
33800	
34000	; STORAGE:
34200	
34400	NWD:	0			;FOR NUMBER OF WORDS OF INPUT.
34600	↓BUF1:	BLOCK	BUFSIZ+1	;BUFFER 1
34800	BUF2:	BLOCK	BUFSIZ+1	;BUFFER 2
35000	
35010	DMD:	'DMD   '
35200	DIR2: 'MUSIC '		;FILENAME FOR INPUT
35400		'MUS   '			;EXTENSION
35600		0			;INFORMATION ON FILE
35800		0			;PROJECT PROG#
36000	DIR:	0    			;NAME
36200		0			;EXTENSION
36400		0			;INFORMATION ON FILE
36600		0			;PROJECT PROG#
36800	CLIST:	IOWD	1,NWD		;FOR THE FIRST RECORD
37000		0
37200	INLIST:	0			;WILL CONTAIN AN IOWD
37400		0
37600	OUTWC:	0			;WILL CONTAIN AN IOWD FOR D-A
37800		3650			;MAGIC BITS FOR 136.
38000	OUTBIT: 4000			;BITS FOR D-A
38200		BLOCK	2
38400	
38800	
39000	A←1
39200	B←2
39400	D←3
39800	
40200	ichn←adchn
45600	
45800	END BEG